Experiment 1 Analysis

Garrett Frady, Ziyang Wang & Tim Moore

2023-01-06

Background

This document contains different statistical methods and analyses, as well as visualization, regarding Experiment 1 of the project. In this section, we explain the details regarding Experiment 1.

Aim: Determine if NHC communication can outperform a pass-alarm in navigating to a disabled firefighter.

Tasks: - navigate to a specific location withing the environment either while seeking out a clearly audible PASS alarm, or while being guided by the V-T Belt system - determine the bearing to the target point at start of trail - determine bearing to start point at end of trial

Failure: timeout before reaching target location

Below is a table of the successful/unsuccessful runs:

# necessary package to read in data
library(readxl) 
# data setup 
dat1 <- read_xlsx("FPL Consolidated Trial Data_update.xlsx", sheet = 1, 
                  na = "NA")
dat1 <- janitor::clean_names(dat1)

# add an additional column denoting success as a binary variable; 0 = failure and 1 = success
dat1$success.bin <- ifelse(dat1$success=="yes", 1, 0)
exp1_succ <- as.data.frame(with(dat1 %>% filter(experiment==1), table(success)))
exp1succ <- knitr::kable(
  exp1_succ,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = exp1succ, latex_options = 'hold_position')
success Freq
no 13
yes 95

The remaining sections will include a generalized linear mixed-effects model for success, paired t-tests for equality of means, tests for equality of variances based on an approach from a Wilcox paper, and paired t-tests for the start/end bearing.

Generalized Linear Mixed-Effects Models for Success - Logistic Regression

Logistic regression models with success/failure as the binary response variable; \(y = 1\) indicates success and \(y = 0\) indicates failure. The fixed effects predictors are trial_type and path. We also include an interaction term between trial_type and path, which is a fixed effects predictor. Then participant_number (ID) is random effects predictor included in the model.

We want to determine whether wearing the belt vs. not wearing the belt is significant in determining whether a subject successfully completes a path or not. Due to the fact that each subject only does a single run with the belt or without the belt for a given path, we include the path as a fixed effect in our models. This way we will be able to determine if the path is significant in determining success vs. failure.

We fit a logistic regression model on the binary response variable for success/failure. We include two fixed effects covariates for path and trial_type (belt vs. no belt), and include an interaction term between the two fixed effects covariates. We also include a random effect for ID, accounting for the fact that we have repeated observations on individual firefighters. By observing the fitted models, we are able to determine which covariates have a significant impact on the response (success/failure). One can also observe diagnostic plots to examine the goodness of fit for the models.

Regression coefficients for the two separate models are on the logit scale (i.e., the scale of the ‘log of the odds’, which is the link function used). We can use post-estimation functions to predict values from these model that help us make sense of these coefficients. Here, we present two types of predictions: estimate marginal means and (conditional) predicted values. Both can be useful for interpreting the results, as they convert the regression coefficients to the probability scale. What that means for our models, is that these predictions show the predicted probability of success.

Our expectation is that the belt will increase the probability of success. Based on our earlier exploratory analyses, we expect this effect to be greater in experiment 2, where we see larger proportion of successes with the belt.

Visualization

Let’s look at the success and failures for each of the three paths.

Path 1

# tables for success
succ_tabs <- with(dat1 %>% filter(experiment==1), table(success, trial_type, path))
succ1 <- knitr::kable(
  succ_tabs[, , 1],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = succ1, latex_options = 'hold_position')
no_belt yes_belt
no 4 0
yes 14 18

Path 2

succ2 <- knitr::kable(
  succ_tabs[, , 2],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = succ2, latex_options = 'hold_position')
no_belt yes_belt
no 4 4
yes 14 14

Path 3

succ3 <- knitr::kable(
  succ_tabs[, , 3],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = succ3, latex_options = 'hold_position')
no_belt yes_belt
no 0 1
yes 18 17

Success Plotting

Below is a plot demonstrating the success and failures for with and without the belt over each of the three paths. A point near 1.00 indicates a success and a point near 0.00 indicates a failure. Each of the three plots are separated by path type. On the left hand side of each plot, the (red) points denote runs without the belt, and on the right and side of each plot, the (blue) points denote runs with the belt.

# Success Plotting
ggplot(data = dat1 %>% filter(experiment==1), 
       aes(x=trial_type, y = success.bin, color = trial_type), size = 3)+
  geom_jitter(width = 0.5, height=0.001)+
  facet_grid(~path)

Alternative Plotting

The figure below contains simple line plots for each of the subjects. There are a total of three plots for each subject, representing the three paths taken. In each line plot, the point on the left denotes whether the subject was successful (around 1.00) or was a failure (around 0.00) without the belt, and the point on the right denotes the same but with the belt. Hence, a horizontal line at 1 indicates the subject was successful both with and without the belt, whereas a horizontal line at 0 indicates the subject failed both with and without the belt. A line with a positive slope indicates the subject failed without the belt and succeeded with the belt, which is what we would like to see. A line with a negative slope indicates the subject succeeded without the belt and failed with the belt, which is not necessarily what we want to see.

# Alternative Plotting
ggplot(data = dat1 %>% filter(experiment==1, participant_number %in% c(4, 6, 7, 8, 9, 10)), 
       aes(x=trial_type, y = success.bin, color = trial_type), size = 3)+
  geom_point()+
  geom_line(aes(group = interaction(participant_number)))+
  facet_wrap(participant_number~path, ncol = 3)

ggplot(data = dat1 %>% filter(experiment==1, participant_number %in% c(11, 12, 13, 14, 15, 17)), 
       aes(x=trial_type, y = success.bin, color = trial_type), size = 3)+
  geom_point()+
  geom_line(aes(group = interaction(participant_number)))+
  facet_wrap(participant_number~path, ncol = 3)

ggplot(data = dat1 %>% filter(experiment==1, participant_number %in% c(18, 19, 20, 21, 23, 24)), 
       aes(x=trial_type, y = success.bin, color = trial_type), size = 3)+
  geom_point()+
  geom_line(aes(group = interaction(participant_number)))+
  facet_wrap(participant_number~path, ncol = 3)

Outcomes

#------------------------------------------------------------------------------#
# Generalized Linear Mixed-Effects Models: Success as Binary Response Variable #

# in this section, we fit logistic regression models with trial_type, path, ...
# ... and the interaction between trial_type and path as fixed effects; we ...
# ... also include participant_number as a random effects term. 

# by multplying the two predictors, we are adding the interaction term; we ...
#   trial_type * path = tryal_type + path + trial_type:path
# ... do not need to include trial_type + path as it automatically does so \
# ... for us when using trial_type*path
# That is, compared to the previous models, the only difference here is the...
# ... interaction term is included

##### Fit the model #####
library(glmmTMB) # linear and generalized mixed-effects models (with extensions) 
library(dplyr) # package to use piping for data manipulation

# generalized linear mixed-effects model
glmm1 <- glmmTMB(success.bin ~ trial_type*path + (1|participant_number),
                 data = dat1 %>% filter(experiment==1), 
                 family = binomial)

# summary of the model fit
sum1 <- summary(glmm1)
# create data frames for each table in sum1 above in order to create nice output
sum1_fix <- as.data.frame(sum1$coefficients$cond)
sum1_ran <- as.data.frame(sum1$varcor$cond)
sum1_varcov <- as.data.frame(as.matrix(sum1$vcov))

The table below contains the estimates of the coefficients for each of the fixed effects. The intercept is for path 1 without the belt. The “Estimate” column contains the coefficient estimates for the fixed-effects predictors, and the “Std. Error” column is the standard error associated to the estimates. The column titled “z value” contains the values of the test statistics and “Pr(>|z|)” contains the p-values from the tests for significance. We can see from the table that the only significant predictor is the interaction of path 1 and no belt, because the corresponding p-value is less than 0.05.

sum1_fix_tab <- knitr::kable(
  sum1_fix, digits = 4,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum1_fix_tab, latex_options = 'hold_position')
Estimate Std. Error z value Pr(>|z|)
(Intercept) 1.6726 0.8060 2.0752 0.0380
trial_typeyes_belt 20.8886 309.5359 0.0675 0.9462
pathE1P2 0.0000 0.9001 0.0000 1.0000
pathE1P3 19.4606 512.0777 0.0380 0.9697
trial_typeyes_belt:pathE1P2 -20.8886 309.5358 -0.0675 0.9462
trial_typeyes_belt:pathE1P3 -38.5063 481.6289 -0.0800 0.9363

The table below contains the estimate of the variance component for the random effect.

sum1_ran_tab <- knitr::kable(
  sum1_ran, digits = 4,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum1_ran_tab, latex_options = 'hold_position')
grp var1 var2 vcov sdcor
participant_number (Intercept) NA 1.6723 1.2932

The table below shows the variance-covariance matrix for all of the fixed effects.

sum1_varcov_tab <- knitr::kable(
  sum1_varcov, digits = 4,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum1_varcov_tab, latex_options = 'hold_position')
(Intercept) trial_typeyes_belt pathE1P2 pathE1P3 trial_typeyes_belt:pathE1P2 trial_typeyes_belt:pathE1P3
(Intercept) 0.6497 -0.0353 -0.4051 -0.2433 0.0353 -0.0305
trial_typeyes_belt -0.0353 95812.4528 -0.1728 -63034.3420 -95812.0150 -32777.8531
pathE1P2 -0.4051 -0.1728 0.8101 0.5081 -0.2323 0.0698
pathE1P3 -0.2433 -63034.3420 0.5081 262223.6089 63034.0113 -199188.2257
trial_typeyes_belt:pathE1P2 0.0353 -95812.0150 -0.2323 63034.0113 95812.3873 32777.7459
trial_typeyes_belt:pathE1P3 -0.0305 -32777.8531 0.0698 -199188.2257 32777.7459 231966.4053

We are reporting the results from an anova test run on mod1. It reports the p-values of significance for each fixed effects predictor being included in the model. A p-value less than 0.05 implies the predictor is significant, otherwise the predictor is not significant, i.e., has no significant relationship with the response (success vs. failure).Below is a table denoting the output of an anova test on mod1. We can see that both of the fixed effects included in the model are not significantly related to the response.

# package to run tests such as anova on a fitted model
library(car)
# run anova on mod1 using the car package
anv1 <- Anova(glmm1)

anv1_tab <- knitr::kable(
  as.data.frame(anv1), digits = 4,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = anv1_tab, latex_options = 'hold_position')
Chisq Df Pr(>Chisq)
trial_type 0.0000 1 1.0000
path 2.0891 2 0.3519
trial_type:path 0.0000 2 1.0000

Statistical Inference and Estimation

Estimated marginal means provide an “average” of the outcome for different combinations of treatment. In our case, the response success/failure is binary, so the estimated marginal means will represent the probability of success at different combinations of the treatment. Treatment here means different combinations of the two fixed effects predictors, path type and trial_type (belt vs. no belt). Below is a figure containing three plots (one in each column) of the estimated marginal means for each treatment. The y-axis is the predicted probability of success. Each column is separated by the path type, so we are getting the estimated marginal probability of success for with vs. without the belt over each of the three paths. We would like to see a positive slope in each of three plots indicating a higher probability of success with the belt compared to without the belt, which is what we are seeing.

# package to examine the estimated marginal means
# library(emmeans)

# fit an emmeans model for factors trial_type and path
em1_int <- emmeans(glmm1, ~ trial_type | path)
# interaction plot of emms for trial_type and path; type = response indicates we want to...
# ... inverse-transform the predictions
ip1_int <- emmip(em1_int, ~ trial_type | path, type = "response", bias.adjust = TRUE)
ip1_int

We include tables of predictive probabilities and \(95\%\) confidence intervals for the predictive probabilities over all combinations of treatments. We also include plots representing the predictive probabilities and the associated \(95\%\) confidence intervals. Below is a table of predictive probabilities and their \(95\%\) confidence intervals over all treatments.

# package for predictions 
# library(ggeffects)

# predictions for glmm1
pred1_int <- ggpredict(glmm1, terms = c("trial_type", "path"))
# ggemmeans(mod1, terms = "trial_type")
# plot(ggemmeans(mod1, terms = "trial_type"))

pred1_tab_int <- knitr::kable(
  pred1_int %>% as.data.frame(), digits = 4,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = pred1_tab_int, latex_options = 'hold_position')
x predicted std.error conf.low conf.high group
yes_belt 1.0000 25840.1518 0.0000 1.0000 E1P1
yes_belt 0.8419 0.8064 0.5230 0.9628 E1P2
yes_belt 0.9711 1.2878 0.7294 0.9976 E1P3
no_belt 0.8419 0.8064 0.5230 0.9628 E1P1
no_belt 0.8419 0.8064 0.5230 0.9628 E1P2
no_belt 1.0000 18554.6583 0.0000 1.0000 E1P3

The figure below a plot using the values in the table above of predictive probabilities for experiment 1. The right hand side of each plot represents the predictive probabilities for with the belt, and the left hand side is for without the belt. We would like to see each of the lines on the right clearly above those on the left. This is not necessarily the case.

plot(pred1_int)

Model Diagnostics

Residual plots are a good way to check the goodness of fit for a certain model. In our case, we are checking whether or not the logistic regression model is an adequate fit for the data. The idea is that the residuals should be independent and identically distributed, as well as uncorrelated with the random effect term in the model. These are some of the logistic regression model assumptions that must be satisfied. Otherwise, the model is not a good fit for the data. Below is a plot of simulated residuals from the fit of mod1. In the plot titled “QQ plot residuals”, we expect the points on the plot to follow closely to the line. We see that this is the case for the most part, which indicates that mod1 is an appropriate fit for the data.

# Model Diagnostics 
library(DHARMa) # package to create interpretable residuals for visualization

# Experiment 1

# residual diagnostic plots
plot(simulateResiduals(glmm1))

Here, we are checking whether the predicted lines from the model resemble the observed lines from the data. We expect to see the predicted lines to follow closely to the model lines if we believe our model has good predictive power. Otherwise, the model does not have good predictive power, and is likely not a good fit for the data. The plot below a plot of the predictive power of the model. We can see that the predicted lines follow closely to the observed line, which indicates that mod1 has good predictive power and implies that mod1 is an appropriate fit for the data.

# package to check the posterior predictive power for different frequentist models
library(performance)

# check posterior prediction for mod1; 100 iterations
check_post1_int <- check_posterior_predictions(glmm1, 100)
check_post1_int

Random Effects

We expect the random effect terms for each of the participants to be approximately normally distributed, and centered at 0.

Paired Tests for Path Distance Traveled and Time Spent - Belt vs. No Belt

We intend to show that, conditioned on success, there is no significant difference in group means for path distance traveled (belt vs no belt), using paired t-tests. In order to do so, we must only consider pairs of trials which are successful with and without the belt for a given path. Similarly, we will conduct a test of equal means between the groups for time spent.

We also intend to show that, conditioned on success, there is a significant difference in variances for path distance traveled (belt vs no belt), using a paired technique defined in a Wilcox paper. In order to do so, we must only consider pairs of trials which are successful with and without the belt for a given path, as explained previously. Similarly, we will conduct a test of equal variance between the groups for time spent.

To test equality of means in each scenario, we will be using a paired t-test as the two samples (belt vs no belt) are dependent. This is a big reason we can only consider pairs of trials which result in success with and without the belt for a given path. Our expectation is that there will not be a significant difference in means for any of the situations.

To test equality of variances in each scenario, we are using a paired technique based on transformations of the dependent samples. We found a technique from a Wilcox paper, which is easily implemented and interpreted.

# the idea here is to show that there is no difference in means between ...
# ... the groups; we see this in the plots
# we use a paired t-test as the two samples are dependent; it is the same ...
# ... people in the belt group and the no belt group, hence dependence

# determining the pairs of participants and paths which result in a success...
# ... both with the belt and without the belt
same_res <- dat1 %>% group_by(participant_number, path) %>% 
  summarise(count_succ = sum(success.bin))

# adding count_succ to the original data, and selecting the columns of interest
dat2 <- left_join(dat1, same_res, by = c("participant_number", "path")) %>%
  select(participant_number, path, trial_type, experiment, count_succ, 
         success.bin, path_distance_meters, time_seconds, success)

# filter data to only consider successful runs both with and without the belt
succ_dat <- dat2 %>% filter(count_succ == 2)

# select only the columns we need for the t test on path distance traveled
succ_dat_path <- succ_dat %>% select(path_distance_meters, trial_type, experiment, path)

###### separate the data by path and trial_type ######
# path distance for with the belt
yes_belt_path_dist11 <- as.data.frame(succ_dat_path %>% 
                                        filter(trial_type == "yes_belt", experiment == 1,
                                               path == "E1P1") %>%
                                        select(path_distance_meters))[, 1]
yes_belt_path_dist12 <- as.data.frame(succ_dat_path %>% 
                                        filter(trial_type == "yes_belt", experiment == 1,
                                               path == "E1P2") %>%
                                        select(path_distance_meters))[, 1]
yes_belt_path_dist13 <- as.data.frame(succ_dat_path %>% 
                                        filter(trial_type == "yes_belt", experiment == 1,
                                               path == "E1P3") %>%
                                        select(path_distance_meters))[, 1]

# path distance for without the belt 
no_belt_path_dist11 <- as.data.frame(succ_dat_path %>% 
                                      filter(trial_type == "no_belt", experiment == 1, 
                                             path == "E1P1") %>%
                                      select(path_distance_meters))[, 1]
no_belt_path_dist12 <- as.data.frame(succ_dat_path %>% 
                                      filter(trial_type == "no_belt", experiment == 1, 
                                             path == "E1P2") %>%
                                      select(path_distance_meters))[, 1]
no_belt_path_dist13 <- as.data.frame(succ_dat_path %>% 
                                      filter(trial_type == "no_belt", experiment == 1,
                                             path == "E1P3") %>%
                                      select(path_distance_meters))[, 1]

Visualization

This section consists of plots to visualize the change in path distance traveled between the with belt group and without belt group, and similarly for time spent.

Path Distance Traveled

Recall, we expected all of the tests for means to be insignificant and the tests for variances to be significant based on previous boxplots. We can see that the boxplots containing the paired data show something different. Below is a plot with all paths included.

# package for ggplots
# library(ggplot2)

# look at change in path distance with/without belt
# experiment 1 
ggplot(data = dat2 %>% filter(experiment==1), aes(x = trial_type,
                                                  y = path_distance_meters))+
  geom_boxplot()+
  geom_point(aes(color = path), size = 3)+
  geom_line(aes(color = path, group = path))

Plots separated by path: Path 1, then Path 2, then Path 3.

# path distance 
ggplot(data = dat2 %>% filter(experiment==1, path == "E1P1"), aes(x = trial_type, 
                                                  y = path_distance_meters))+
  geom_boxplot()+
  geom_point(size = 3)+
  geom_line()

ggplot(data = dat2 %>% filter(experiment==1, path == "E1P2"), aes(x = trial_type, 
                                                  y = path_distance_meters))+
  geom_boxplot()+
  geom_point(size = 3)+
  geom_line()

ggplot(data = dat2 %>% filter(experiment==1, path == "E1P3"), aes(x = trial_type, 
                                                  y = path_distance_meters))+
  geom_boxplot()+
  geom_point(size = 3)+
  geom_line()

Plot separated by participant.

ggplot(data = succ_dat %>% filter(experiment==1), aes(x = trial_type, 
                        y = path_distance_meters))+
  geom_boxplot()+
  geom_point( aes(color = path), size = 3)+
  geom_line(aes(color = path, group = path))+
  facet_wrap(~participant_number, scales = "free_y")

Plot where boxplots are separated by path and belt vs. no belt.

ggplot(data = succ_dat %>% filter(experiment==1), 
       aes(x = interaction(trial_type,path), 
           y = path_distance_meters))+
  facet_wrap(~experiment)+
  geom_boxplot()+
  geom_jitter(width = 0.1, height = 0, aes(color = path))+
  theme(axis.text.x=element_text(angle = 90))

Plot only separated by belt vs. no belt.

ggplot(data = succ_dat %>% filter(experiment == 1), 
       aes(x = interaction(trial_type), 
           y = path_distance_meters))+
  geom_boxplot()+
  geom_jitter(width = 0.1, height = 0, aes(color = trial_type))+
  theme(axis.text.x=element_text(angle = 90))

Time Spent

All paths in one plot.

# look at change in time spent with/without belt
# experiment 1 
ggplot(data = dat2 %>% filter(experiment==1), aes(x = trial_type, 
                                                  y = time_seconds))+
  geom_boxplot()+
  geom_point(aes(color = path), size = 3)+
  geom_line(aes(color = path, group = path))

Plots separated by path: Path 1, then Path 2, then Path 3.

# Time Spent
ggplot(data = dat2 %>% filter(experiment==1, path == "E1P1"), aes(x = trial_type, 
                                                  y = time_seconds))+
  geom_boxplot()+
  geom_point(size = 3)+
  geom_line()

ggplot(data = dat2 %>% filter(experiment==1, path == "E1P2"), aes(x = trial_type, 
                                                  y = time_seconds))+
  geom_boxplot()+
  geom_point(size = 3)+
  geom_line()

ggplot(data = dat2 %>% filter(experiment==1, path == "E1P3"), aes(x = trial_type, 
                                                  y = time_seconds))+
  geom_boxplot()+
  geom_point(size = 3)+
  geom_line()

Plot separated by participant.

ggplot(data = succ_dat %>% filter(experiment==1), aes(x = trial_type, 
                        y = time_seconds))+
  geom_boxplot()+
  geom_point( aes(color = path), size = 3)+
  geom_line(aes(color = path, group = path))+
  facet_wrap(~participant_number, scales = "free_y")

Plot where boxplots are separated by path and belt vs. no belt.

ggplot(data = succ_dat %>% filter(experiment==1), 
       aes(x = interaction(trial_type,path), 
           y = time_seconds))+
  facet_wrap(~experiment)+
  geom_boxplot()+
  geom_jitter(width = 0.1, height = 0, aes(color = path))+
  theme(axis.text.x=element_text(angle = 90))

Plot only separated by belt vs. no belt.

ggplot(data = succ_dat %>% filter(experiment == 1), 
       aes(x = interaction(trial_type), 
           y = time_seconds))+
  geom_boxplot()+
  geom_jitter(width = 0.1, height = 0, aes(color = trial_type))+
  theme(axis.text.x=element_text(angle = 90))

Outcomes

Paired T-Tests for Group Means - Path Distance Traveled

The reason for choosing a paired t-test is due to the fact that two populations are dependent as it is the same group of people in the group with the belt and the group without the belt. We are running these tests by conditioning on success and separating by path in each of the two experiments. Since a paired test requires equal sample sizes from the two samples, we can only consider pairs of trials where the individual completed the same path both with and without the belt.

The null hypothesis is that there is no significant difference in group means, and the alternative is that there is a significant difference in the group means. Thus, small p-values (generally p-value < 0.05) imply that we reject the null and may conclude that there is sufficient evidence to conclude there is a significant difference in group means. Otherwise, we are unable to conclude that there is a significant difference between group means.

Results from the paired t-tests are provided in the tables below. From top to bottom, we see the results from path 1, then path 2, and then path 3.

# function to create data frame and eventually table of paired t-test results
tab_ttest <- function(test) {
  data.frame(
    est = as.numeric(test$estimate),
    lower95 = test$conf.int[1],
    upper95 = test$conf.int[2],
    t = as.numeric(test$statistic),
    pval = test$p.value,
    row.names = ""
  )
}
# run the paired t tests for each path in experiment 1 separately
dist_test11 <- t.test(yes_belt_path_dist11, no_belt_path_dist11, paired = TRUE)
dist_test12 <- t.test(yes_belt_path_dist12, no_belt_path_dist12, paired = TRUE)
dist_test13 <- t.test(yes_belt_path_dist13, no_belt_path_dist13, paired = TRUE)

The table below shows the results from the paired t-test for path 1. The p-value for the test is approximately 0.0543, which is larger than 0.05, and thus, indicates that there is not sufficient evidence that there is a difference in group means.

dist11 <- knitr::kable(
  tab_ttest(dist_test11),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = dist11, latex_options = 'hold_position')
est lower95 upper95 t pval
-9.22754 -18.65398 0.1988958 -2.114785 0.0543334

The table below shows the results from the paired t-test for path 2. The p-value for the test is approximately 0.1895, which is larger than 0.05, and thus, indicates that there is not sufficient evidence that there is a difference in group means.

dist12 <- knitr::kable(
  tab_ttest(dist_test12),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = dist12, latex_options = 'hold_position')
est lower95 upper95 t pval
-5.946214 -15.35781 3.465379 -1.407731 0.1895285

The table below shows the results from the paired t-test for path 3. The p-value for the test is approximately 0.1015, which is larger than 0.05, and thus, indicates that there is not sufficient evidence that there is a difference in group means.

dist13 <- knitr::kable(
  tab_ttest(dist_test13),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = dist13, latex_options = 'hold_position')
est lower95 upper95 t pval
-14.45339 -32.08692 3.18014 -1.737588 0.1014896

The results for the paired t-tests for path distance traveled over all three paths were insignificant, i.e., we did not reject the null hypothesis. Thus, we may conclude that there is not a significant difference in group means, which is what we desired.

Paired T-Tests for Group Means - Time Spent

# select only the columns we need for the t test on time spent
succ_dat_time <- succ_dat %>% select(time_seconds, trial_type, experiment, path)

# time spent for with the belt for experiment 1
yes_belt_time11 <- as.data.frame(succ_dat_time %>% 
                                   filter(trial_type == "yes_belt", experiment == 1, 
                                          path == "E1P1") %>%
                                   select(time_seconds))[, 1]
yes_belt_time12 <- as.data.frame(succ_dat_time %>% 
                                  filter(trial_type == "yes_belt", experiment == 1, 
                                         path == "E1P2") %>%
                                  select(time_seconds))[, 1]
yes_belt_time13 <- as.data.frame(succ_dat_time %>% 
                                  filter(trial_type == "yes_belt", experiment == 1, 
                                         path == "E1P3") %>%
                                  select(time_seconds))[, 1]

# path distance for without the belt for experiment 1
no_belt_time11 <- as.data.frame(succ_dat_time %>% 
                                  filter(trial_type == "no_belt", experiment == 1, 
                                         path == "E1P1") %>%
                                  select(time_seconds))[, 1]
no_belt_time12 <- as.data.frame(succ_dat_time %>% 
                                 filter(trial_type == "no_belt", experiment == 1, 
                                        path == "E1P2") %>%
                                 select(time_seconds))[, 1]
no_belt_time13 <- as.data.frame(succ_dat_time %>% 
                                 filter(trial_type == "no_belt", experiment == 1, 
                                        path == "E1P3") %>%
                                 select(time_seconds))[, 1]
# run the paired t tests for each path in experiment 1 separately
time_test11 <- t.test(yes_belt_time11, no_belt_time11, paired = TRUE)
time_test12 <- t.test(yes_belt_time12, no_belt_time12, paired = TRUE)
time_test13 <- t.test(yes_belt_time13, no_belt_time13, paired = TRUE)

The table below shows the results from the paired t-test for path 1. The p-value for the test is approximately 0.8288, which is larger than 0.05, and thus, indicates that there is not sufficient evidence that there is a difference in group means.

time11 <- knitr::kable(
  tab_ttest(time_test11),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = time11, latex_options = 'hold_position')
est lower95 upper95 t pval
-3.714286 -40.08371 32.65514 -0.2206311 0.828807

The table below shows the results from the paired t-test for path 2. The p-value for the test is approximately 0.6036, which is larger than 0.05, and thus, indicates that there is not sufficient evidence that there is a difference in group means.

time12 <- knitr::kable(
  tab_ttest(time_test12),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = time12, latex_options = 'hold_position')
est lower95 upper95 t pval
-8.181818 -42.18866 25.82502 -0.5360753 0.6036254

The table below shows the results from the paired t-test for path 3. The p-value for the test is approximately 0.3400, which is larger than 0.05, and thus, indicates that there is not sufficient evidence that there is a difference in group means.

time13 <- knitr::kable(
  tab_ttest(time_test13),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = time13, latex_options = 'hold_position')
est lower95 upper95 t pval
-7 -22.08668 8.086676 -0.9836054 0.3399505

The results for the paired t-tests for time spent over all three paths were insignificant. Thus, we may conclude that there is not a significant difference in group means, which is what we desired.

Wilcox Based Test for Equality in Group Variances - Path Distance Traveled

To test equality of variances in each scenario, we are using an approach explained in a Wilcox paper. Since the two samples are dependent, we needed to be careful with which test we chose. Wilcox’s approach considers heteroskedasticity in the data, it is straightforward to implement, and is easily interpreted. Once again, this requires equal sized paired samples. We expect that there will be a significant difference in variances for each of the situations.

The null hypothesis essentially states that the variances are equal. If we obtain significant evidence against the null hypothesis, we may conclude that there is a difference in the group variances. Otherwise, we are unable to claim that there is a significant difference in the group variances. Significant means that the p-value is less than the level of significance, which is generally taken to be 0.05.

##############################################################################
# Conditioned on Success: test from Wilcox Paper for difference in variances #
##############################################################################

# the idea here is to show that there is a difference in variances between ...
# ... the groups; we see this in the plots
# since the two samples are dependent, we can't use a typical F test or ...
# ... other common tests used for equality of variances
# we will be using a test proposed by Wilcox which takes into account the ...
# ... heteroskedasticity in the data

# test for path distance
U_path11 <- yes_belt_path_dist11 + no_belt_path_dist11
V_path11 <- yes_belt_path_dist11 - no_belt_path_dist11
U_path12 <- yes_belt_path_dist12 + no_belt_path_dist12
V_path12 <- yes_belt_path_dist12 - no_belt_path_dist12
U_path13 <- yes_belt_path_dist13 + no_belt_path_dist13
V_path13 <- yes_belt_path_dist13 - no_belt_path_dist13

# fit linear model
m_path11 <- lm(U_path11 ~ V_path11)
m_path12 <- lm(U_path12 ~ V_path12)
m_path13 <- lm(U_path13 ~ V_path13)

# package for hccm function
library(car)
# heteroskedasticity corrected covariance
cov11 <- hccm(m_path11)
cov12 <- hccm(m_path12)
cov13 <- hccm(m_path13)
# package for the coeftest function
library(lmtest)
# test for equal variances
vartest11 <- coeftest(m_path11, vcov. = cov11)
vartest12 <- coeftest(m_path12, vcov. = cov12)
vartest13 <- coeftest(m_path13, vcov. = cov13)

The table below shows the results of the Wilcox based approach to test equality of variances for path 1 (path distance traveled). The p-value for the test is approximately 0.000016, which is less than 0.05. Thus, there is sufficient evidence to conclude that there is a difference in group variances.

# results for path 1 (path distance traveled)
vdist11 <- knitr::kable(
  vartest11[1:2, ],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = vdist11, latex_options = 'hold_position')
Estimate Std. Error t value Pr(>|t|)
(Intercept) 46.601878 1.2890875 36.151059 0.0000000
V_path11 -0.955019 0.1383194 -6.904448 0.0000164

The table below shows the results of the Wilcox based approach to test equality of variances for path 2 (path distance traveled). The p-value for the test is approximately 0.0339, which is less than 0.05. Thus, there is sufficient evidence to conclude that there is a difference in group variances.

# results for path 2 (path distance traveled)
vdist12 <- knitr::kable(
  vartest12[1:2, ],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = vdist12, latex_options = 'hold_position')
Estimate Std. Error t value Pr(>|t|)
(Intercept) 56.3826781 4.670562 12.071926 0.0000007
V_path12 -0.5365619 0.214741 -2.498647 0.0339371

The table below shows the results of the Wilcox based approach to test equality of variances for path 3 (path distance traveled). The p-value for the test is approximately 0.000019, which is less than 0.05. Thus, there is sufficient evidence to conclude that there is a difference in group variances.

# results for path 3 (path distance traveled)
vdist13 <- knitr::kable(
  vartest13[1:2, ],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = vdist13, latex_options = 'hold_position')
Estimate Std. Error t value Pr(>|t|)
(Intercept) 48.976480 2.0871074 23.466200 0.0000000
V_path13 -1.086459 0.1769611 -6.139533 0.0000189

In all three tests for equal variances for path distance traveled, we see that there is sufficient evidence indicating that the group variances are significantly different, which is what we desired.

Wilcox Based Test for Equality in Group Variances - Time Spent

# test for time spent
U_time11 <- yes_belt_time11 + no_belt_time11
V_time11 <- yes_belt_time11 - no_belt_time11
U_time12 <- yes_belt_time12 + no_belt_time12
V_time12 <- yes_belt_time12 - no_belt_time12
U_time13 <- yes_belt_time13 + no_belt_time13
V_time13 <- yes_belt_time13 - no_belt_time13

# fit linear model
m_time11 <- lm(U_time11 ~ V_time11)
m_time12 <- lm(U_time12 ~ V_time12)
m_time13 <- lm(U_time13 ~ V_time13)

# heteroskedasticity corrected covariance
cov11_time <- hccm(m_time11)
cov12_time <- hccm(m_time12)
cov13_time <- hccm(m_time13)

# test for equal variances
vartime11 <- coeftest(m_time11, vcov. = cov11_time)
vartime12 <- coeftest(m_time12, vcov. = cov12_time)
vartime13 <- coeftest(m_time13, vcov. = cov13_time)

The table below shows the results of the Wilcox based approach to test equality of variances for path 1 (time spent). The p-value for the test is approximately 0.0049, which is less than 0.05. Thus, there is sufficient evidence to conclude that there is a difference in group variances.

# results for path 1 (time spent)
vtime11 <- knitr::kable(
  vartime11[1:2, ],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = vtime11, latex_options = 'hold_position')
Estimate Std. Error t value Pr(>|t|)
(Intercept) 178.1731706 19.2737047 9.244366 0.0000008
V_time11 -0.6841464 0.1989273 -3.439178 0.0049019

The table below shows the results of the Wilcox based approach to test equality of variances for path 2 (time spent). The p-value for the test is approximately 0.4813, which is greater than 0.05. Thus, there is not sufficient evidence to conclude a difference in group variances.

# results for path 2 (time spent)
vtime12 <- knitr::kable(
  vartime12[1:2, ],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = vtime12, latex_options = 'hold_position')
Estimate Std. Error t value Pr(>|t|)
(Intercept) 175.4208472 28.6357570 6.1259371 0.0001737
V_time12 -0.4485631 0.6106852 -0.7345243 0.4813278

The table below shows the results of the Wilcox based approach to test equality of variances for path 3 (time spent). The p-value for the test is approximately 0.0770, which is greater than 0.05. Thus, there is not sufficient evidence to conclude a difference in group variances.

# results for path 3 (time spent)
vtime13 <- knitr::kable(
  vartime13[1:2, ],
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = vtime13, latex_options = 'hold_position')
Estimate Std. Error t value Pr(>|t|)
(Intercept) 148.2224414 19.4444749 7.622857 0.0000016
V_time13 -0.8337689 0.4391225 -1.898716 0.0770107

In equal variance tests for path 2 and 3, there is not a significant difference in group variances, which is not what we expected.

Statistical Inference and Estimation

Not sure what we want to put here.

Model Diagnostics

Not sure what we want to put here.

Start Bearing and End Bearing - Belt vs. No Belt

Visualization

Path 1 - Start Bearing

Below is a grid containing two plots denoting the start bearing over all subjects for path 1, both with and without the belt.

library(cowplot) # for grids

# Path 1 - start bearing
# no belt
start_nobelt_p <-
ggplot(data = dat1 %>% filter(path=="E1P1"), 
         aes(x = start_bearing_no_belt, y =1))+
  geom_point()+
  geom_point(aes(x = 346, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

# belt
start_belt_p <-
ggplot(data = dat1 %>% filter(path=="E1P1"), 
         aes(x = start_bearing_with_belt, y =1))+
  geom_point()+
  geom_point(aes(x = 346, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

plot_grid(start_nobelt_p, start_belt_p, ncol = 2, 
          labels = "E1P1")

Path 1 - End Bearing

Below is a grid containing two plots denoting the end bearing over all subjects for path 1, both with and without the belt.

# path 1 - end bearing
# no belt
end_nobelt_p <-
ggplot(data = dat1 %>% filter(path=="E1P1", `trial_type`=="yes_belt"), 
         aes(x = `end_bearing_no_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 179, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

# belt
end_belt_p <-
ggplot(data = dat1 %>% filter(path=="E1P1"), 
         aes(x = `end_bearing_with_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 179, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

plot_grid(end_nobelt_p, end_belt_p, ncol = 2, 
          labels = "E1P1")

Path 2 - Start Bearing

Below is a grid containing two plots denoting the start bearing over all subjects for path 2, both with and without the belt.

# path 2 - start bearing
# no belt
start_nobelt_p <-
ggplot(data = dat1 %>% filter(path=="E1P2"), 
         aes(x = `start_bearing_no_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 143, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

# belt
start_belt_p <-
ggplot(data = dat1 %>% filter(path=="E1P2"), 
         aes(x = `start_bearing_with_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 143, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

plot_grid(start_nobelt_p, start_belt_p, ncol = 2, 
          labels = "E1P2")

Below is a grid containing two plots denoting the end bearing over all subjects for path 1, both with and without the belt.

# path 2 - end bearing
# no belt
end_nobelt_p <-
ggplot(data = dat1 %>% filter(path=="E1P2", `trial_type`=="yes_belt"), 
         aes(x = `end_bearing_no_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 315, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

# belt
end_belt_p <-
ggplot(data = dat1 %>% filter(path=="E1P2"), 
         aes(x = `end_bearing_with_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 315, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

plot_grid(end_nobelt_p, end_belt_p, ncol = 2, 
          labels = "E1P2")

Path 3 - Start Bearing

Below is a grid containing two plots denoting the start bearing over all subjects for path 3, both with and without the belt.

# path 3 - start bearing
# no belt
start_nobelt_p <-
ggplot(data = dat1 %>% filter(path=="E1P3"), 
         aes(x = `start_bearing_no_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 302, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

# belt
start_belt_p <-
ggplot(data = dat1 %>% filter(path=="E1P3"), 
         aes(x = `start_bearing_with_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 302, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

plot_grid(start_nobelt_p, start_belt_p, ncol = 2, 
          labels = "E1P3")

Below is a grid containing two plots denoting the end bearing over all subjects for path 3, both with and without the belt.

# path 3 - end bearing
# no belt
end_nobelt_p <-
ggplot(data = dat1 %>% filter(path=="E1P3", `trial_type`=="yes_belt"), 
         aes(x = `end_bearing_no_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 119, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

# belt
end_belt_p <-
ggplot(data = dat1 %>% filter(path=="E1P3"), 
         aes(x = `end_bearing_with_belt`, y =1))+
  geom_point()+
  geom_point(aes(x = 119, y = 1), size= 3, color = "red")+
  scale_x_continuous(breaks=c(0, 90, 180, 270, 360), limits = c(0, 360))+
  coord_polar(start = 0)+
  theme_bw()

plot_grid(end_nobelt_p, end_belt_p, ncol = 2, 
          labels = "E1P3")

Histogram of Differences of Start Bearing for Path 1 - No Belt vs. Belt

The grid below contains two histograms of the differences in start bearing from true bearing, both with and without the belt, for path 1.

library(stringr)
bearing <- dat1 %>% dplyr::select(participant_number,
                           trial_type, path, 
                           starts_with("start"),
                           starts_with("end"),
                           starts_with("actual"))

bearing_start_no_belt <- bearing %>% 
  filter(!is.na(start_bearing_no_belt), path=="E1P1") %>% data.frame()

bearing_start_belt <- bearing %>% 
  filter(!is.na(`start_bearing_with_belt`), path=="E1P1") %>% data.frame()

# bearing_start_no_belt %>% group_by(participant_number)%>% tally() %>%
#   data.frame()
# 
# bearing_start_belt %>% group_by(participant_number)%>% tally() %>%
#   data.frame()


bearing_start_no_belt$condition <- "no belt"
bearing_start_belt$condition <- "belt"

# # participant 17 is problematic: missing start bearing no belt E2P1
# 
# bearing_start_no_belt <- bearing_start_no_belt %>% 
#                           filter(!participant.number==17)
# bearing_start_belt <- bearing_start_belt %>% 
#                           filter(!participant.number==17)

bearing_start_no_belt$diffs <- 
  180 - abs(abs(bearing_start_no_belt$start_bearing_no_belt - 
                  bearing_start_no_belt$actual_start_bearing) - 180)
h1nb_st <- hist(bearing_start_no_belt$diffs)

sum1nb_st <- summary(bearing_start_no_belt$diffs)

bearing_start_belt$diffs <-   
  180 - abs(abs(bearing_start_belt$start_bearing_with_belt - 
                  bearing_start_belt$actual_start_bearing) - 180)
h1b_st <- hist(bearing_start_belt$diffs)

sum1b_st <- summary(bearing_start_belt$diffs)

# plot_grid(h1nb_st, h1b_st, ncol = 2, 
#           labels = "E1P1")

Histogram of Differences of End Bearing for Path 1 - No Belt vs. Belt

The grid below contains two histograms of the differences in end bearing from true bearing, both with and without the belt, for path 1.

bearing_end_no_belt <- bearing %>% 
  filter(!is.na(`end_bearing_no_belt`), path=="E1P1", `trial_type`=="yes_belt") %>% data.frame()

bearing_end_belt <- bearing %>% 
  filter(!is.na(`end_bearing_with_belt`), path=="E1P1") %>% data.frame()

# bearing_end_no_belt %>% group_by(participant.number)%>% tally() %>%
#   data.frame()
# 
# bearing_end_belt %>% group_by(participant.number)%>% tally() %>%
#   data.frame()

bearing_end_no_belt$condition <- "no belt"
bearing_end_belt$condition <- "belt"

bearing_end_no_belt$diffs <- 
  180 - abs(abs(bearing_end_no_belt$end_bearing_no_belt - 
                  bearing_end_no_belt$actual_end_bearing) - 180)
hist(bearing_end_no_belt$diffs)

sum1nb_end <- summary(bearing_end_no_belt$diffs)

bearing_end_belt$diffs <-   180 - 
  abs(abs(bearing_end_belt$end_bearing_with_belt - 
                  bearing_end_belt$actual_end_bearing) - 180)
hist(bearing_end_belt$diffs)

sum1b_end <- summary(bearing_end_belt$diffs)

Histogram of Differences of Start Bearing for Path 2 - No Belt vs. Belt

The grid below contains two histograms of the differences in start bearing from true bearing, both with and without the belt, for path 2.

# path 2
bearing_start_no_belt2 <- bearing %>% 
  filter(!is.na(start_bearing_no_belt), path=="E1P2") %>% data.frame()

bearing_start_belt2 <- bearing %>% 
  filter(!is.na(`start_bearing_with_belt`), path=="E1P2") %>% data.frame()

# bearing_start_no_belt2 %>% group_by(participant_number)%>% tally() %>%
#   data.frame()
# 
# bearing_start_belt2 %>% group_by(participant_number)%>% tally() %>%
#   data.frame()


bearing_start_no_belt2$condition <- "no belt"
bearing_start_belt2$condition <- "belt"

bearing_start_no_belt2$diffs <- 
  180 - abs(abs(bearing_start_no_belt2$start_bearing_no_belt - 
                  bearing_start_no_belt2$actual_start_bearing) - 180)
h2nb_st <- hist(bearing_start_no_belt2$diffs)

sum2nb_st <- summary(bearing_start_no_belt2$diffs)

bearing_start_belt2$diffs <-   
  180 - abs(abs(bearing_start_belt2$start_bearing_with_belt - 
                  bearing_start_belt2$actual_start_bearing) - 180)
h2b_st <- hist(bearing_start_belt2$diffs)

sum2b_st <- summary(bearing_start_belt2$diffs)

# plot_grid(h2nb_st, h2b_st, ncol = 2, 
#           labels = "E1P2")

Histogram of Differences of End Bearing for Path 2 - No Belt vs. Belt

The grid below contains two histograms of the differences in end bearing from true bearing, both with and without the belt, for path 2.

bearing_end_no_belt2 <- bearing %>% 
  filter(!is.na(`end_bearing_no_belt`), path=="E1P2", `trial_type`=="yes_belt") %>% data.frame()

bearing_end_belt2 <- bearing %>% 
  filter(!is.na(`end_bearing_with_belt`), path=="E1P2") %>% data.frame()

# bearing_end_no_belt %>% group_by(participant.number)%>% tally() %>%
#   data.frame()
# 
# bearing_end_belt %>% group_by(participant.number)%>% tally() %>%
#   data.frame()

bearing_end_no_belt2$condition <- "no belt"
bearing_end_belt2$condition <- "belt"

bearing_end_no_belt2$diffs <- 
  180 - abs(abs(bearing_end_no_belt2$end_bearing_no_belt - 
                  bearing_end_no_belt2$actual_end_bearing) - 180)
hist(bearing_end_no_belt2$diffs)

sum2nb_end <- summary(bearing_end_no_belt2$diffs)

bearing_end_belt2$diffs <-   180 - 
  abs(abs(bearing_end_belt2$end_bearing_with_belt - 
                  bearing_end_belt2$actual_end_bearing) - 180)
hist(bearing_end_belt2$diffs)

sum2b_end <- summary(bearing_end_belt2$diffs)

Histogram of Differences of Start Bearing for Path 3 - No Belt vs. Belt

The grid below contains two histograms of the differences in start bearing from true bearing, both with and without the belt, for path 3.

# path 3
bearing_start_no_belt3 <- bearing %>% 
  filter(!is.na(start_bearing_no_belt), path=="E1P3") %>% data.frame()

bearing_start_belt3 <- bearing %>% 
  filter(!is.na(`start_bearing_with_belt`), path=="E1P3") %>% data.frame()

# bearing_start_no_belt3 %>% group_by(participant_number)%>% tally() %>%
#   data.frame()
# 
# bearing_start_belt3 %>% group_by(participant_number)%>% tally() %>%
#   data.frame()

bearing_start_no_belt3$condition <- "no belt"
bearing_start_belt3$condition <- "belt"

bearing_start_no_belt3$diffs <- 
  180 - abs(abs(bearing_start_no_belt3$start_bearing_no_belt - 
                  bearing_start_no_belt3$actual_start_bearing) - 180)
h3nb_st <- hist(bearing_start_no_belt3$diffs)

sum3nb_st <- summary(bearing_start_no_belt3$diffs)

bearing_start_belt3$diffs <-   
  180 - abs(abs(bearing_start_belt3$start_bearing_with_belt - 
                  bearing_start_belt3$actual_start_bearing) - 180)
h3b_st <- hist(bearing_start_belt3$diffs)

sum3b_st <- summary(bearing_start_belt3$diffs)

# plot_grid(h3nb_st, h3b_st, ncol = 2, 
#           labels = "E1P3")

Histogram of Differences of End Bearing for Path 3 - No Belt vs. Belt

The grid below contains two histograms of the differences in end bearing from true bearing, both with and without the belt, for path 3.

bearing_end_no_belt3 <- bearing %>% 
  filter(!is.na(`end_bearing_no_belt`), path=="E1P3", `trial_type`=="yes_belt") %>% data.frame()

bearing_end_belt3 <- bearing %>% 
  filter(!is.na(`end_bearing_with_belt`), path=="E1P3") %>% data.frame()

# bearing_end_no_belt %>% group_by(participant.number)%>% tally() %>%
#   data.frame()
# 
# bearing_end_belt %>% group_by(participant.number)%>% tally() %>%
#   data.frame()

bearing_end_no_belt3$condition <- "no belt"
bearing_end_belt3$condition <- "belt"

bearing_end_no_belt3$diffs <- 
  180 - abs(abs(bearing_end_no_belt3$end_bearing_no_belt - 
                  bearing_end_no_belt3$actual_end_bearing) - 180)
hist(bearing_end_no_belt3$diffs)

sum3nb_end <- summary(bearing_end_no_belt3$diffs)

bearing_end_belt3$diffs <-   180 - 
  abs(abs(bearing_end_belt3$end_bearing_with_belt - 
                  bearing_end_belt3$actual_end_bearing) - 180)
hist(bearing_end_belt3$diffs)

sum3b_end <- summary(bearing_end_belt3$diffs)

Outcomes

Path 1 - Bearing Results

A summary of the differences of start bearing for path 1, with and with the belt, is shown in the table below.

sum1_st <- rbind(sum1nb_st, sum1b_st)
row.names(sum1_st) <- c("no belt", "belt")
sum1st <- knitr::kable(
  sum1_st,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum1st, latex_options = 'hold_position')
Min. 1st Qu. Median Mean 3rd Qu. Max.
no belt 4 6.75 12.5 20.55556 32.00 64
belt 1 6.75 12.5 14.83333 19.75 41

The table below shows the results of the t-test for a difference in group means regarding the start bearing for path 1. Note, we are comparing the mean of the differences from the actual start bearing. The p-value is approximately 0.2382, which is greater than 0.05. Thus, there is no significant difference in means between the two groups.

# prepare for paired t-test
start_comp <- 
  rbind(bearing_start_no_belt[, c("participant_number", "condition", "diffs")],
        bearing_start_belt[, c("participant_number", "condition", "diffs")])

start_comp$condition <- factor(start_comp$condition)

startdiffs1 <- t.test(diffs ~ condition,  data = start_comp, paired = TRUE)
stdiffs1 <- knitr::kable(
  tab_ttest(startdiffs1),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = stdiffs1, latex_options = 'hold_position')
est lower95 upper95 t pval
-5.722222 -15.59725 4.152802 -1.222562 0.2381748

A summary of the differences of end bearing for path 1, with and with the belt, is shown in the table below.

sum1_end <- rbind(sum1nb_end, sum1b_end)
row.names(sum1_end) <- c("no belt", "belt")
sum1end <- knitr::kable(
  sum1_end,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum1end, latex_options = 'hold_position')
Min. 1st Qu. Median Mean 3rd Qu. Max.
no belt 1 10.25 20 31.00000 44.25 94
belt 1 11.00 21 25.22222 26.00 159

The table below shows the results of the t-test for a difference in group means regarding the end bearing for path 1. Note, we are comparing the mean of the differences from the actual end bearing. The p-value is approximately 0.4815, which is greater than 0.05. Thus, there is no significant difference in means between the two groups.

end_comp <- 
  rbind(bearing_end_no_belt[, c("participant_number", "condition", "diffs")],
        bearing_end_belt[, c("participant_number", "condition", "diffs")])

end_comp$condition <- factor(end_comp$condition)

enddiffs1 <- t.test(diffs ~ condition,  data = end_comp, paired = TRUE)
ediffs1 <- knitr::kable(
  tab_ttest(enddiffs1),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = ediffs1, latex_options = 'hold_position')
est lower95 upper95 t pval
-5.777778 -22.71443 11.15887 -0.7197437 0.4814617

Path 2 - Bearing Results

A summary of the differences of start bearing for path 2, with and with the belt, is shown in the table below.

sum2_st <- rbind(sum2nb_st, sum2b_st)
row.names(sum2_st) <- c("no belt", "belt")
sum2st <- knitr::kable(
  sum2_st,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum2st, latex_options = 'hold_position')
Min. 1st Qu. Median Mean 3rd Qu. Max.
no belt 2 13.50 25.5 44.50000 59.25 152
belt 3 4.25 17.0 25.55556 36.00 82

The table below shows the results of the t-test for a difference in group means regarding the start bearing for path 2. Note, we are comparing the mean of the differences from the actual start bearing. The p-value is approximately 0.1356, which is greater than 0.05. Thus, there is no significant difference in means between the two groups.

start_comp2 <- 
  rbind(bearing_start_no_belt2[, c("participant_number", "condition", "diffs")],
        bearing_start_belt2[, c("participant_number", "condition", "diffs")])

start_comp2$condition <- factor(start_comp2$condition)

startdiffs2 <- t.test(diffs ~ condition,  data = start_comp2, paired = TRUE)
stdiffs2 <- knitr::kable(
  tab_ttest(startdiffs2),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = stdiffs2, latex_options = 'hold_position')
est lower95 upper95 t pval
-18.94444 -44.45654 6.567647 -1.56668 0.1356136

A summary of the differences of end bearing for path 2, with and with the belt, is shown in the table below.

sum2_end <- rbind(sum2nb_end, sum2b_end)
row.names(sum2_end) <- c("no belt", "belt")
sum2end <- knitr::kable(
  sum2_end,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum2end, latex_options = 'hold_position')
Min. 1st Qu. Median Mean 3rd Qu. Max.
no belt 0 16.25 37.5 54.44444 87.50 170
belt 0 11.25 25.0 23.94444 30.75 60

The table below shows the results of the t-test for a difference in group means regarding the end bearing for path 2. Note, we are comparing the mean of the differences from the actual end bearing. The p-value is approximately 0.0363, which is less than 0.05. Thus, there is a significant difference in means between the two groups.

end_comp2 <- 
  rbind(bearing_end_no_belt2[, c("participant_number", "condition", "diffs")],
        bearing_end_belt2[, c("participant_number", "condition", "diffs")])

end_comp2$condition <- factor(end_comp2$condition)

enddiffs2 <- t.test(diffs ~ condition,  data = end_comp2, paired = TRUE)
ediffs2 <- knitr::kable(
  tab_ttest(enddiffs2),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = ediffs2, latex_options = 'hold_position')
est lower95 upper95 t pval
-30.5 -58.81039 -2.189614 -2.272995 0.0362879

Path 3 - Bearing Results

A summary of the differences of start bearing for path 2, with and with the belt, is shown in the table below.

sum3_st <- rbind(sum3nb_st, sum3b_st)
row.names(sum3_st) <- c("no belt", "belt")
sum3st <- knitr::kable(
  sum3_st,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum3st, latex_options = 'hold_position')
Min. 1st Qu. Median Mean 3rd Qu. Max.
no belt 12 18.25 27.5 35.38889 44.50 107
belt 2 8.00 12.5 15.61111 25.75 37

The table below shows the results of the t-test for a difference in group means regarding the start bearing for path 3. Note, we are comparing the mean of the differences from the actual start bearing. The p-value is approximately 0.0126, which is less than 0.05. Thus, there is a significant difference in means between the two groups.

start_comp3 <- 
  rbind(bearing_start_no_belt3[, c("participant_number", "condition", "diffs")],
        bearing_start_belt3[, c("participant_number", "condition", "diffs")])

start_comp3$condition <- factor(start_comp3$condition)

startdiffs3 <- t.test(diffs ~ condition,  data = start_comp3, paired = TRUE)
stdiffs3 <- knitr::kable(
  tab_ttest(startdiffs3),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = stdiffs3, latex_options = 'hold_position')
est lower95 upper95 t pval
-19.77778 -34.74273 -4.81283 -2.788347 0.0126108

A summary of the differences of end bearing for path 3, with and with the belt, is shown in the table below.

sum3_end <- rbind(sum3nb_end, sum3b_end)
row.names(sum3_end) <- c("no belt", "belt")
sum3end <- knitr::kable(
  sum3_end,
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = sum3end, latex_options = 'hold_position')
Min. 1st Qu. Median Mean 3rd Qu. Max.
no belt 4 19 33.5 41.11111 60.50 96
belt 1 4 8.5 17.77778 32.75 49

The table below shows the results of the t-test for a difference in group means regarding the end bearing for path 3. Note, we are comparing the mean of the differences from the actual end bearing. The p-value is approximately 0.0021, which is less than 0.05. Thus, there is a significant difference in means between the two groups.

end_comp3 <- 
  rbind(bearing_end_no_belt3[, c("participant_number", "condition", "diffs")],
        bearing_end_belt3[, c("participant_number", "condition", "diffs")])

end_comp3$condition <- factor(end_comp3$condition)

enddiffs3 <- t.test(diffs ~ condition,  data = end_comp3, paired = TRUE)
ediffs3 <- knitr::kable(
  tab_ttest(enddiffs3),
  format.args = list(scientific = F),
  booktabs = T
)
kable_styling(kable_input = ediffs3, latex_options = 'hold_position')
est lower95 upper95 t pval
-23.33333 -36.90505 -9.761612 -3.627324 0.0020817

Statistical Inference and Estimation

Not sure what we are going to put here.

Model Diagnostics

Not sure what we are going to put here.

Perception

Not sure what our approach is with this section.

# percep <- dat1 %>% select(`participant number`, 
#                           `experienced with building`, gender, age, 
#                           `total years experience`,
#                           starts_with("q"))
# 
# library(psych)
# alpha(percep[, 6:21], check.keys = TRUE)
# 
# 
# percep$mean.sent <- apply(percep[, 6:21], 1, mean)
# 
# qs_rev <-reverse.code(keys = c(1, -1, 1, 1, 1, 1, 1,
#                       -1, 1, 1, -1, -1, -1, 1, 1, 1), 
#                       percep[, 6:21])

Visualization

Outcomes

Statistical Inference and Estimation

Model Diagnostics